home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / language / dino / dino_bot.1 / source / library / D_lib.c < prev    next >
Encoding:
C/C++ Source or Header  |  1991-09-20  |  59.7 KB  |  1,807 lines
  1. /* Copyright, 1990, Regents of the University of Colorado */
  2.                    /***************************************
  3.                     ***************************************
  4.                     **                                   **
  5.                     **  IPSC1 Run Time Library for DINO  **
  6.                     **                                   **
  7.                     ***************************************
  8.                     ***************************************/
  9.  
  10. #include "D_lib.h"
  11. #include "internal.h"
  12. #include "export.h"
  13. #include "route.h"
  14. #include <stdio.h>
  15. #if D_MACH==D_CUBE
  16. #include <dos/malloc.h>
  17. #else
  18. #include <malloc.h>
  19. #endif
  20. #include <ctype.h>
  21.  
  22.  
  23.  
  24.    
  25.                    /*****************************
  26.                     *                           *
  27.                     *     Library variables.    *
  28.                     *                           *
  29.                     *****************************/
  30.  
  31. /** MY STUFF **/
  32. char ch[100];
  33.  
  34. #if (D_MACH==D_SIM || D_MACH==D_CUBE)
  35. int D_ci = -1;                  /* Channel number. */
  36. #endif
  37. envvar caller = {0,0};
  38. envvar D_snd_source = {0,0};
  39. long int D_TYPE_START = 0;           /* Starting number for message types. */
  40. long int D_TYPE_END = 0;             /* Last number for message types + 1. */
  41. long int D_TYPE_CURRENT = 0;         /* Next message type. */
  42. /*envvar D_my_env = {0, 0};*/        /* The environment structure and environment
  43.                                                     on this node and pid. */
  44.  
  45. /* This code forces the alignment of D_mess_buf */
  46. double D_mess_tmp [D_MAX_MESS / sizeof (double)];
  47. char *D_mess_buf = (char *) &D_mess_tmp [0];
  48.  
  49. /* Here are the variables used by the new composite procedure stuff */
  50. char *D_buf = 0;
  51. long int D_rem = 0;
  52. int D_le = 0;
  53. int D_main_type = 0;
  54. int D_sub_type = 0;
  55. D_env_set *D_es = (D_env_set *) 0;
  56. int D_cp = 0;
  57. int D_env_size = 0;
  58. int D_n_envs = 0;
  59. D_BOOL D_first_msg = FALSE;
  60. int D_node;
  61. int D_pid;
  62. long int D_size;
  63.  
  64. char D_mess_buf2[D_MAX_MESS];
  65. D_process **D_env_lookup = {0};
  66.  
  67. envvar **D_process_lookup = {0};
  68.  
  69. extern int D_mach_dims;
  70. extern int D_max_pids;
  71.  
  72.  
  73.  
  74.  
  75.      
  76. /********************************************************************
  77.  *
  78.  *  NAME:       D_env_init --- Initializes the environment lookup table.
  79.  *
  80.  *  INPUTS:     A storage space descriptor, a data distribution
  81.  *              descriptor, an environment set, a data mapping
  82.  *              descriptor, a data name descriptor, and a data
  83.  *              iteration descriptor.  
  84.  *
  85.  *  OUTPUTS:    The data iteration descriptor may be updated for
  86.  *              handling multiple calls.
  87.  *
  88.  *  NOTES:      See the formal interface description for more
  89.  *              information.
  90.  *
  91.  ********************************************************************/
  92.  
  93. void D_env_init(num_envs)
  94.     int num_envs;
  95.     {
  96.     int env;
  97.     int mach_size;
  98.     int I, J;
  99.     D_env_tbl *e;
  100.     int size = 1;
  101.     int *work;              /* Holds the number of processors in each
  102.                                                                 dimension. */
  103. #if D_HOST ==0
  104.     int hold;
  105. #endif
  106.  
  107.     mach_size = (1 << D_mach_dims);
  108.  
  109.     /* Allocate the outer part of both lookup tables. */
  110.  
  111.     if ((D_env_lookup = (D_process **) malloc((unsigned)
  112.                                     (num_envs * sizeof(D_process *)))) == NULL)
  113.         {
  114. #if (D_MACH==D_SIM || D_MACH==D_CUBE || D_MACH==D_GRAIL) 
  115.         syslog(1, "Malloc failure in initializing environments\n\n");
  116. #else
  117.         fprintf(stderr,"NODE:%d,PID:%d;Malloc failure in initializing environments \n\n",mynode(),mypid());
  118. #endif
  119.         exit(1);
  120.         }
  121.     if ((D_process_lookup = (envvar **) malloc((unsigned)
  122.                            (mach_size * sizeof(envvar *)))) == NULL)
  123.         {
  124. #if (D_MACH==D_SIM || D_MACH==D_CUBE || D_MACH==D_GRAIL)
  125.         syslog(1, "Malloc failure in initializing environments\n\n");
  126. #else
  127.         fprintf(stderr,"NODE:%d,PID:%d;Malloc failure in initializing environments \n\n",mynode(),mypid());
  128. #endif
  129.  
  130.         exit(1);
  131.         }
  132.  
  133. #if D_HOST && (D_MACH==D_SIM2 || D_MACH==D_CUBE2 || D_MACH == D_CUBE860 || D_MACH==D_GRAIL)
  134.     setpid(D_HOST_PID);
  135. #endif
  136.  
  137.         /* Compute the size of work and allocate it. */
  138.  
  139.  
  140.     for (env = 0; env < num_envs; env++)
  141.         if (D_env_table[env].n_dims > size)
  142.             size = D_env_table[env].n_dims;
  143.     if ((work = (int *) malloc((unsigned) (size * sizeof(int)))) == NULL)
  144.         {
  145. #if (D_MACH==D_SIM || D_MACH==D_CUBE || D_MACH==D_GRAIL)
  146.         syslog(1, "Malloc failure in initializing environments\n\n");
  147. #else
  148.         fprintf(stderr,"NODE:%d,PID:%d;Malloc failure in initializing environments \n\n",mynode(),mypid());
  149. #endif
  150.         exit(1);
  151.         }
  152.  
  153.         /* For every node on the machine: */
  154.  
  155.     for (I = 0; I < mach_size; I++)
  156.        {
  157.             /* Allocate the rest of the process lookup table. */
  158.  
  159.         if ((D_process_lookup[I] = (envvar *) malloc((unsigned)
  160.                                     (D_max_pids * sizeof(envvar)))) == NULL)
  161.            {
  162. #if (D_MACH==D_SIM || D_MACH==D_CUBE || D_MACH==D_GRAIL)
  163.             syslog(1, "Malloc failure in initializing environments\n\n");
  164. #else
  165.             fprintf(stderr,"NODE:%d,PID:%d;Malloc failure in initializing environments \n\n",mynode(),mypid());
  166. #endif
  167.             exit(1);
  168.            }
  169.  
  170.             /* Initialize the process lookup table. */
  171.  
  172.         for (J = 0; J < D_max_pids; J++)
  173.             D_process_lookup[I][J].name = -1;
  174.        }
  175.  
  176.         /* For every environment structure in the program: */
  177.  
  178.     for (env = 0; env < num_envs; env++)
  179.        {
  180.         e = &D_env_table[env];
  181.  
  182.             /* Allocate the rest of the environment lookup table. */
  183.  
  184.         if ((D_env_lookup[env] = (D_process *) malloc((unsigned)
  185.                                     (e->size * sizeof(D_process)))) == NULL)
  186.             {
  187. #if (D_MACH==D_SIM || D_MACH==D_CUBE || D_MACH==D_GRAIL)
  188.             syslog(1, "Malloc failure in initializing environments\n\n");
  189. #else
  190.             fprintf(stderr,"NODE:%d,PID:%d;Malloc failure in initializing environments \n\n",mynode(),mypid());
  191. #endif
  192.             exit(1);
  193.             }
  194.  
  195.             /* If it is the host environment, treat it specially. */
  196.  
  197.         if (e->on_host)
  198.             {
  199. #if (D_MACH == D_SIM2 || D_MACH == D_CUBE2 || D_MACH == D_CUBE860 || D_MACH == D_GRAIL)
  200.             D_env_lookup[env][0].node = myhost();
  201. #else
  202.             D_env_lookup[env][0].node = D_HOST_NID;
  203. #endif
  204.             D_env_lookup[env][0].pid = D_HOST_PID;
  205.             }
  206.  
  207.             /* Otherwise, for every environment on a node: */
  208.  
  209.         else
  210.             {
  211.             int proc;
  212.             int pid;
  213.             int ord;
  214.             int lookup[64];     /* Table used to store mapping from
  215.                                         up to 64 node virtual machine to
  216.                                         up to 64 node physical machine. */
  217.  
  218.             /* If there is a full machine or larger, compute a lookup
  219.                     table for an appropriately dimensioned machine. */
  220.  
  221.             if (e->is_big)
  222.                 {
  223.                 int I, J, K;        /* Counters. */
  224.  
  225.                 int temp;           /* Used to compute the coordinates of
  226.                                                        the physical node. */
  227.                 int ptemp;          /* Used to compute the linearized
  228.                                             position of the virtual node. */
  229.                 int hold, hold2;    /* Used to compute the inverse gray code. */
  230.                 int mid, block, mpt;/* Used to select the appropriate physical
  231.                                                                 machine node. */
  232.                 int coords[7];      /* Holds the coordinates of first the
  233.                                          physical, then the virtual node. */
  234.                 int dim_limit = e->n_dims<D_mach_dims?e->n_dims:D_mach_dims;
  235.                                     /* The lesser of the number of
  236.                                         dimensions in the environment
  237.                                         structure and the number of
  238.                                         dimensions in the actual machine. */
  239.                 int t_pos;          /* Position of an actual element in
  240.                                                     a particular dimension. */
  241.  
  242.                 /* Compute the number of processors in each dimension. */
  243.  
  244.                 for (J = 0; J < e->n_dims; J++)
  245.                     work[J] = 1 << e->mach_dim[J];
  246.  
  247.                 /* For each processor in the physical machine: */
  248.  
  249.                 for (I = 0; I < (1 << D_mach_dims); I++)
  250.                     {
  251.  
  252.                     /* Compute its coordinates and change them
  253.                         to coordinates in the virtual machine; */
  254.  
  255.                     temp = I;
  256.                     for (J = dim_limit - 1; J >= 0; J--)
  257.                         {
  258.                             /* Get the coordinates for this dimension. */
  259.  
  260.                         coords[J] = temp % work[J];
  261.                         temp = temp/work[J];
  262.  
  263.                             /* Compute their inverse gray code. */
  264.  
  265.                         hold = coords[J]/2;
  266.                         hold2 = coords[J];
  267.                         while (hold != 0)
  268.                             {
  269.                             hold2 = hold2 ^ hold;
  270.                             hold = hold/2;
  271.                             }
  272.                         coords[J] = hold2;
  273.                         }
  274.  
  275.                     /* Linearize the virtual machine coordinates; */
  276.  
  277.                     ptemp = coords[0];
  278.                     for (J = 1; J < dim_limit; J++)
  279.                         ptemp = (ptemp * work[J]) + coords[J];
  280.  
  281.                     /* Store the results in the lookup table. */
  282.  
  283.                     lookup[ptemp] = I;
  284.                     }
  285.  
  286.                     /* For each environment in the structure: */
  287.  
  288.                 for (I = 0; I < e->size; I++)
  289.                     {
  290.                         /* Initialize all the variables for the
  291.                                                 lowest dimension. */
  292.                     t_pos = I;
  293.                     for (K = e->n_dims - 1; K > 0; K--)
  294.                         t_pos /= e->dim[K];      /* Position in this dimension.*/
  295.                     mid = e->dim[0] % work[0];   /* Number of large blocks. */
  296.                     block = e->dim[0] / work[0]; /* Size of block. */
  297.                     mpt = mid * (block + 1);    /* First point small blocks. */
  298.                     if (mid == 0)
  299.                         {
  300.                         proc = t_pos / block;
  301.                         pid = t_pos % block;
  302.                         }
  303.                     else
  304.                         {
  305.                         if (t_pos > mpt)
  306.                             {
  307.                             proc = mid + (t_pos - mpt) / block;
  308.                             pid = (t_pos - mpt) % block;
  309.                             }
  310.                         else
  311.                             {
  312.                             proc = t_pos / (block + 1);
  313.                             pid = t_pos % (block + 1);
  314.                             }
  315.                         }
  316.                         /* Iterate through each subsequent dimension. */
  317.  
  318.                     for (J = 1; J < e->n_dims; J++)
  319.                         {
  320.                         t_pos = I;
  321.                         for (K = e->n_dims - 1; K > J; K--)
  322.                             t_pos /= e->dim[K];
  323.                         t_pos %= e->dim[J];
  324.                         mid = e->dim[J] % work[J];
  325.                         block = e->dim[J] / work[J];
  326.                         mpt = mid * (block + 1);
  327.                         if (mid == 0)
  328.                             {
  329.                             proc = proc * work[J] + t_pos / block;
  330.                             pid = pid * e->pids[J] + t_pos % block;
  331.                             }
  332.                         else
  333.                             {
  334.                             if (t_pos > mpt)
  335.                                 {
  336.                                 proc = proc * work[J] + mid +
  337.                                                     (t_pos - mpt) / block;
  338.                                 pid = pid * e->pids[J] + (t_pos - mpt) % block;
  339.                                 }
  340.                             else
  341.                                 {
  342.                                 proc = proc * work[J] + t_pos / (block + 1);
  343.                                 pid = pid * e->pids[J] + t_pos % (block + 1);
  344.                                 }
  345.                             }
  346.                         }
  347.                     D_env_lookup[env][I].node = lookup[proc];
  348.                     D_env_lookup[env][I].pid =  pid + e->pid;
  349.                     }
  350.                 }
  351.             else
  352.                {
  353.                 int I;          /* Counter. */
  354.                 
  355.                     /* For each environment in the structure: */
  356.  
  357.                 for (I = 0; I < e->size; I++)
  358.                     {
  359.                     ord = e->start + I;
  360.                     D_env_lookup[env][I].node = ord^(ord>>1);
  361.                     D_env_lookup[env][I].pid = e->pid;
  362.                     }
  363.                 }
  364.             }
  365. #if D_HOST
  366.         if(!e->on_host)
  367.            {
  368.             int pid, prod, I;
  369.  
  370. #ifdef DEBUG
  371. {
  372. int Z; char enter[25];
  373. (void) printf("\n\n\tLoad nodes automatically?? (Y/N) -->");
  374. for (Z = 0; Z < 25; Z++){enter[Z] = getchar();if (enter[Z]=='\n'){enter[Z]='\0';break;}}
  375. if(enter[0] == 'y' || enter[0] == 'Y')
  376. {
  377.             if (e->is_big)
  378.                {
  379.                 for (I=0, prod=1; I<e->n_dims; I++)
  380.                     prod *= e->pids[I];
  381.                 for (pid = 0; pid < prod; pid++)
  382.                     load(e->name, -1, pid + e->pid);
  383.                }
  384.             else 
  385.                {
  386.                 if (num_envs < 3 || mach_size == e->size)
  387.                     load(e->name, -1, e->pid);
  388.                 else
  389.                     for (I = 0; I < e->size; I++)
  390.                         load(e->name, D_env_lookup[env][I].node,
  391.                                                     D_env_lookup[env][I].pid);
  392.                }
  393. }}
  394. #else
  395.             if (e->is_big)
  396.                {
  397.                 for (I=0, prod=1; I<e->n_dims; I++)
  398.                     prod *= e->pids[I];
  399.                 for (pid = 0; pid < prod; pid++)
  400.                     load(e->name, -1, pid + e->pid);
  401.                }
  402.             else
  403.                {
  404.                 if (num_envs < 3 || mach_size == e->size)
  405.                     load(e->name, -1, e->pid);
  406.                 else
  407.                     for (I = 0; I < e->size; I++)
  408.                         load(e->name, D_env_lookup[env][I].node,
  409.                                                     D_env_lookup[env][I].pid);
  410.                }
  411. #endif
  412.            }
  413. #endif
  414.        }
  415.    {
  416.     int I, J, node, pid;
  417.     int total, me, host;
  418. #if (D_MACH == D_SIM2 || D_MACH == D_CUBE2 || D_MACH == D_CUBE860 || D_MACH==D_GRAIL)
  419.     int temp = myhost();
  420. #endif
  421.  
  422. #if D_HOST
  423. #if (D_MACH == D_SIM2 || D_MACH == D_CUBE2 || D_MACH == D_CUBE860 || D_MACH==D_GRAIL)
  424.     node = temp;
  425. #else
  426.     node = D_HOST_NID;
  427. #endif
  428.     pid = D_HOST_PID;
  429. #else
  430.     pid = mypid();
  431.     node = mynode();
  432. #endif
  433.  
  434.     D_my_env.index = -1;
  435.     total = 0;
  436.     for(I = 0; I < num_envs; I++)
  437.        {
  438.         for (J = 0; J < D_env_table[I].size; J++)
  439.            {
  440.             if (!D_env_table[I].on_host)
  441.                {
  442.                 D_process_lookup[D_env_lookup[I][J].node]
  443.                                             [D_env_lookup[I][J].pid].name = I;
  444.                 D_process_lookup[D_env_lookup[I][J].node]
  445.                                             [D_env_lookup[I][J].pid].index = J;
  446.                }
  447.             if (D_env_lookup[I][J].node == node &&
  448.                         D_env_lookup[I][J].pid == pid)
  449.                {
  450.                 D_my_env.name = I;
  451.                 D_my_env.index = J;
  452.                 me = total + J;
  453.                }
  454. #if (D_MACH == D_SIM2 || D_MACH == D_CUBE2 || D_MACH == D_CUBE860 || D_MACH==D_GRAIL)
  455.             if (D_env_lookup[I][J].node == temp)
  456. #else
  457.             if (D_env_lookup[I][J].node == D_HOST_NID)
  458. #endif
  459.                 host = total + J;
  460.            }
  461.         total += D_env_table[I].size;
  462.        }
  463.     if (me > host)
  464.         me--;
  465.     size = D_TYPE_BLOCK_SIZE / total;
  466.     if (D_HOST)
  467.        {
  468.         D_TYPE_START = (total - 1) * size + D_TYPE_BLOCK_START;
  469.         D_TYPE_END = D_TYPE_START + size + (D_TYPE_BLOCK_SIZE % total);
  470.         D_TYPE_CURRENT = D_TYPE_START;
  471.        }
  472.     else
  473.        {
  474.         D_TYPE_START = me * size + D_TYPE_BLOCK_START;
  475.         D_TYPE_END = D_TYPE_START + size;
  476.         D_TYPE_CURRENT = D_TYPE_START;
  477.        }
  478.     }
  479.  
  480. #if D_HOST
  481. #if (D_MACH==D_SIM || D_MACH==D_CUBE)
  482.     D_ci = copen(D_HOST_PID); /*initialize THE channel*/
  483. #endif
  484. /* FUNKY DIAGNOSTICS
  485. pr_env_tables(2);
  486. END FUNKY DIAGNOSTICS */
  487. #else
  488. #if (D_MACH==D_SIM || D_MACH==D_CUBE)
  489.     D_ci = copen(mypid()); /*initialize THE channel*/
  490. #endif
  491.     if (D_my_env.index == -1)
  492.         exit(0);
  493.     hold = D_my_env.index;
  494.     for (I = D_env_table[D_my_env.name].n_dims - 1; I >= 0 ; I--)
  495.        {
  496.         *(D_local_env_table[I]) = hold % D_env_table[D_my_env.name].dim[I];
  497.         hold = hold / D_env_table[D_my_env.name].dim[I];
  498.        }
  499. #endif
  500.  
  501.         /* Free the intermediate data structure. */
  502.  
  503.     free((char *) work);
  504. }
  505.  
  506.  
  507. /********************************************************************
  508.  *
  509.  *  NAME:       D_lib_recvs --- Receives one or more messages
  510.  *              necessary to fill in a piece of data.  Assumes
  511.  *              the storage space exists and is of the correct
  512.  *              type.
  513.  *
  514.  *  INPUTS:     A storage space descriptor, a data distribution
  515.  *              descriptor, an environment set, a data mapping
  516.  *              descriptor, a data name descriptor, and an 
  517.  *              environment set.  
  518.  *
  519.  *  OUTPUTS:    
  520.  *
  521.  *  NOTES:      See the formal interface description for more
  522.  *              information.
  523.  *
  524.  ********************************************************************/
  525.  
  526. void D_lib_recvs(P_ssd, P_es, P_ddd, P_dmd, P_dnd, P_sync, P_data)
  527.     D_storage_space_desc *P_ssd;
  528.     D_env_set *P_es;
  529.     D_data_distribution_desc *P_ddd;
  530.     D_data_mapping_desc *P_dmd;
  531.     D_data_name_desc *P_dnd;
  532.     D_data_holder *P_data;
  533.     D_BOOL P_sync;
  534.    {
  535.     int I, J, K, M;
  536.     long int counter;
  537.     D_np *D_env;             /* Array of environments. */
  538.     int count;
  539.     int env_count = 0;
  540.     int this_env;
  541.     D_BOOL empty = FALSE;
  542.     int which;
  543.     int type;
  544.     long int size;
  545.     int header_size;
  546.     register char *bufptr, *dataptr;
  547.     char *tmpptr;
  548. #if  D_HOST && (D_MACH==D_SIM || D_MACH==D_CUBE)
  549.     char *tmpptr2;
  550. #endif
  551.     int cnt, node, pid, dsize;
  552.  
  553.         /* if the dmd has not been converted to node form, do so. */
  554.  
  555.     if (P_es->implicit && (! P_dmd->converted))
  556.         map_transform(P_dmd, D_my_env.index, P_data->a);
  557.  
  558.             /* Initial analysis */
  559.  
  560.                 /* Calculate the total number of environments. */
  561.  
  562.                     /* For each environment structure: */
  563.  
  564.     for (I = 0; I < P_es[0].count; I++)
  565.        {
  566.         K = 1;
  567.                         /* Calculate its size. */
  568.  
  569.         for (J = 0; J < D_env_table[P_es[I].name].n_dims; J++)
  570.             K *= D_env_table[P_es[I].name].dim[J];
  571.  
  572.                         /* If it has a bitmap, count the true bits. */
  573.  
  574.         if (! (P_es[I].implicit || P_es[I].allflag))
  575.            {
  576.             count = 0;
  577.             for (M = 0; M < K; M++)
  578.                 if (P_es[I].bitmap[M])
  579.                     count++;
  580.             env_count += count;
  581.            }
  582.                         /* Otherwise add its whole size to the total. */
  583.         else
  584.             env_count += K;
  585.        }
  586.                 /* Set up the array. */
  587.  
  588.     D_env = P_data->e;
  589.     if (P_es->implicit)
  590.         D_env->total = env_count;
  591.     else
  592.         D_env->total = 1;
  593.  
  594.                 /* Initialize the array. */
  595.  
  596.     for (I = 0; I < D_env->total; I++)
  597.        {
  598.         D_env[I].total = D_env->total;
  599.         D_env[I].name = P_es->name;
  600.         D_env[I].index = I;
  601.         D_env[I].implicit = P_es->implicit;
  602.         D_env[I].done = FALSE;
  603.         D_env[I].node = D_env_lookup[P_es->name][I].node;
  604.         D_env[I].pid = D_env_lookup[P_es->name][I].pid;
  605.         D_env[I].parts = 0;
  606.         D_env[I].offset = 0;
  607.         D_env[I].size[0] = 0;
  608.        }
  609.  
  610.                 /* Compute sizes and internal dnd's. */
  611.  
  612.     if (D_env->name == D_my_env.name)
  613.         this_env = D_my_env.index;
  614.     else
  615.         this_env = -1;
  616.     get_size(P_ssd, P_ddd, P_dmd, P_dnd, D_env,
  617.                             this_env, FALSE, 0, FALSE, P_data->a, P_data->n);
  618.  
  619.             /* If there is nothing to be received,
  620.                         issue an error message and exit the function. */
  621.  
  622.     if (D_env->total == 0)
  623.        {
  624. #if (D_MACH==D_SIM)
  625.         fprintf(stderr,
  626.     "ENV:%d,INDEX:%d;Implicit receive called for data that is only home data.\n",
  627.                                             D_my_env.name,D_my_env.index);
  628. #endif
  629. #if (D_MACH==D_CUBE || D_MACH==D_GRAIL)
  630.     syslog(mypid(), "Implicit receive called for data that is only home data.");
  631. #endif
  632. #if (D_MACH==D_CUBE2)
  633.         fprintf(stderr,
  634.     "ENV:%d,INDEX:%d;Implicit receive called for data that is only home data.\n",
  635.                                             D_my_env.name,D_my_env.index);
  636. #endif
  637. #if (D_MACH==D_CUBE860)
  638.         fprintf(stderr,
  639.     "ENV:%d,INDEX:%d;Implicit receive called for data that is only home data.\n",
  640.                                             D_my_env.name,D_my_env.index);
  641. #endif
  642.         return;
  643.        }
  644.  
  645.                 /* For each environment, compute whether or not
  646.                         it needs a header and the size of that header.*/
  647.  
  648.         for (I = 0; I < D_env->total; I++)
  649.             if (D_env[I].size[0] > 0)
  650.                {
  651.                 if (P_dnd->simple)
  652.                    {
  653.                     if (D_env[I].size[0] > D_MAX_MESS)
  654.                        {
  655.                         D_env[I].header = D_PM_HD_SZ + D_MP_HD_SZ +
  656.                                 2 * sizeof(long int) + D_LM_HD_SZ +
  657.                                 2 * sizeof(long int) + D_LME_DATA_HD_SZ;
  658.                        }
  659.                     else
  660.                        {
  661.                         D_env[I].header = 0;
  662.                        }
  663.                    }
  664.                 else
  665.                     D_env[I].header = D_PM_HD_SZ + D_MP_HD_SZ +
  666.                                 2 * sizeof(long int) + D_LM_HD_SZ +
  667.                                 2 * sizeof(long int) + D_LME_DATA_HD_SZ +
  668.                                 (1 + 2 * P_dnd->dims) * sizeof(long int);
  669.                }
  670.  
  671.             /* end initial analysis. */
  672.  
  673.             /***** MAIN LOOP *****/
  674.  
  675.     I = 0;
  676.     for (;;)
  677.        {
  678.         which = get_message(D_env, P_sync, P_es, &dsize);
  679.         if (which >= 0)
  680.            {
  681.             if (D_env[which].mess != D_NULL)
  682.                {
  683.                 if (D_env[which].desc->dims == 0 &&
  684.                                             D_env[which].size[0] <= D_MAX_MESS)
  685.                    {
  686.                     D_env[which].parts = 1;
  687.                     size = D_env[which].size[0];
  688.                     bufptr = D_env[which].mess;
  689.                    }
  690.                 else
  691.                    {
  692.                     D_env[which].parts = ((long int *) D_env[which].mess)[0];
  693.                     bufptr = D_env[which].mess + D_PM_HD_SZ + D_MP_HD_SZ;
  694.                     bufptr += *((long int *) bufptr) + D_LM_HD_SZ;
  695.                     bufptr += *((long int *) bufptr) + sizeof(long int);
  696.                     bufptr += *((long int *) bufptr) + 2 * sizeof(long int);
  697.                     header_size = bufptr - D_env[which].mess;
  698.                     size = (((D_env[which].size[0] + header_size) >
  699.                                     D_MAX_MESS)?D_MAX_MESS - header_size:
  700.                                                         D_env[which].size[0]);
  701.                    }
  702.                 if (D_env[which].contig[0])
  703.                    {
  704.                     dataptr = D_env[which].loc[0];
  705.                     for (counter = 0; counter < size; counter++)
  706.                         *(dataptr++) = *(bufptr++);
  707.                     D_env[which].offset += size;
  708.                    }
  709.                 else
  710.                    {
  711.                     if (D_env[which].implicit)
  712.                         map_select(P_ddd, P_dmd, D_my_env.index,
  713.                                     D_env[which].index, FALSE, FALSE,
  714.                                     P_data->a, D_env[which].clist[0]);
  715.                     else
  716.                          ddd_xform(P_ssd, P_ddd, D_env[which].clist[0]);
  717.                     tmpptr = bufptr;
  718.                     copy_data(P_ssd, D_env[which].clist[0],
  719.                                                         size, &tmpptr, FALSE);
  720.                     D_env[which].offset += size;
  721.                    }
  722.                 if (D_env[which].mess != D_mess_buf)
  723.                    B_free(D_env[which].mess);
  724.                 if (D_env[which].parts > 1)
  725.                    {
  726.                     type = ((long int *) D_env[which].mess)[1];
  727.                     for (J = 1; J < D_env[which].parts; J++)
  728.                        {
  729.                         bufptr = &(D_mess_buf[0]);
  730. #if D_HOST && (D_MACH==D_SIM || D_MACH==D_CUBE)
  731.                         tmpptr2 = bufptr;
  732.                         D_recvh(D_ci, type, &tmpptr2, D_MAX_MESS,
  733.                                                             &cnt, &node, &pid);
  734. #else
  735. #if (D_MACH==D_SIM || D_MACH==D_CUBE)
  736.                         recvw(D_ci, type, &(D_mess_buf[0]), D_MAX_MESS,
  737.                                                             &cnt, &node, &pid);
  738. #else 
  739.                         crecv((long)type, &(D_mess_buf[0]),(long)D_MAX_MESS);
  740. #endif
  741. #endif
  742.                         size = (((D_env[which].size[0] - D_env[which].offset) >
  743.                                 D_MAX_MESS)?D_MAX_MESS:D_env[which].size[0] -
  744.                                                         D_env[which].offset);
  745.                         if (D_env[which].contig[0])
  746.                            {
  747.                             dataptr = D_env[which].loc[0] +
  748.                                                     D_env[which].offset;
  749.                             for (counter = 0; counter < size; counter++)
  750.                                 *(dataptr++) = *(bufptr++);
  751.                             D_env[which].offset += size;
  752.                            }
  753.                         else
  754.                            {
  755.                             tmpptr = bufptr;
  756.                             copy_data(P_ssd, D_env[which].clist[0], size,
  757.                                                                &tmpptr, FALSE);
  758.                             D_env[which].offset += size;
  759. #if D_HOST && (D_MACH==D_SIM || D_MACH==D_CUBE)
  760.                         if (tmpptr2 != &(D_mess_buf[0]))
  761.                             B_free(bufptr);
  762. #endif
  763.                            }
  764.                        }
  765.                    }
  766.                }
  767.             if (! P_es->implicit)
  768.                 break;
  769.            }
  770.         if (P_sync)
  771.            {
  772.             I++;
  773.             if (I == D_env->total)
  774.                 break;
  775.            }
  776.         else
  777.            {
  778.             if (which < 0)
  779.                {
  780.                 if (empty)
  781.                     break;
  782.                 else
  783.                    {
  784.                     for (J = 0; J < D_env->total; J++)
  785.                         D_env[J].done = FALSE;
  786.                     empty = TRUE;
  787.                    }
  788.                }
  789.             else
  790.                 empty = FALSE;
  791.            }
  792.        }
  793.    }
  794.  
  795.  
  796.  
  797. /********************************************************************
  798.  *
  799.  *  NAME:       D_lib_send --- Sends any one of a variety of messages.
  800.  *
  801.  *  INPUTS:     A storage space descriptor, a data distribution
  802.  *              descriptor, an environment set, a data mapping
  803.  *              descriptor, a data name descriptor, and a data
  804.  *              iteration descriptor.  
  805.  *
  806.  *  OUTPUTS:    The data iteration descriptor may be updated for
  807.  *              handling multiple calls.
  808.  *
  809.  *  NOTES:      See the formal interface description for more
  810.  *              information.
  811.  *
  812.  ********************************************************************/
  813.  
  814. void D_lib_send(P_ssd, P_es, P_ddd, P_dmd, P_dnd, P_data)
  815.     D_storage_space_desc *P_ssd;
  816.     D_env_set *P_es;
  817.     D_data_distribution_desc *P_ddd;
  818.     D_data_mapping_desc *P_dmd;
  819.     D_data_name_desc *P_dnd;
  820.     D_data_holder *P_data;
  821.     {
  822.             /* Function variables */
  823.  
  824.     static D_BOOL first = TRUE; /* Is this the first of an iterative message? */
  825.     int D_current_env;          /* Current environment. */
  826.     static int D_part_num = 1;  /* Maximum number of parts
  827.                                                     involved in a message. */
  828.     int D_current_part;         /* Current part. */
  829.     static int D_sub_type;      /* Type for subsequent parts of message. */
  830.     D_np *D_env;                /* Array of environments. */
  831.     char *bufptr, *dataptr;     /* Pointers to various message buffers. */
  832.     char *buf;                  /* The message buffer used for this message. */
  833.     int env_count = 0;
  834.     int size;                   /* Temporary storage for message size. */
  835.     int temp_size;
  836.     long int bufsize;           /* Size of temporary buffer. */
  837.     char *charp;                /* Pointers used to construct buffer. */
  838.     int I, J, K, M, count;      /* Index variables. */
  839.     long int temp[5];           /* Array used to construct headers. */
  840.     int this_env;               /* Index of this environment. */
  841.     D_BOOL working;
  842.     int node, pid;
  843.  
  844.  
  845.         /* if the dmd has not been converted to node form, do so. */
  846.  
  847.     if (P_es->implicit && (! P_dmd->converted))
  848.         map_transform(P_dmd, D_my_env.index, P_data->a);
  849.  
  850.             /* Initial analysis */
  851.  
  852.     if (first)
  853.        {
  854.                         /* Set up the environment array. */
  855.  
  856.         for (I = 0; I < P_es[0].count; I++)
  857.            {
  858.             K = 1;
  859.             for (J = 0; J < D_env_table[P_es[I].name].n_dims; J++)
  860.                 K *= D_env_table[P_es[I].name].dim[J];
  861.             if (! (P_es[I].implicit || P_es[I].allflag))
  862.                {
  863.                 count = 0;
  864.                 for (M = 0; M < K; M++)
  865.                     if (P_es[I].bitmap[M])
  866.                         count++;
  867.                 env_count += count;
  868.                }
  869.             else
  870.                 env_count += K;
  871.            }
  872.         D_env = P_data->e;
  873.         if (P_es->implicit)
  874.             D_env->total = env_count;
  875.         else
  876.             D_env->total = 1;
  877.  
  878.         for (I = 0; I < D_env->total; I++)
  879.            {
  880.             D_env[I].total = D_env->total;
  881.             D_env[I].name = P_es->name;
  882.             D_env[I].index = I;
  883.             D_env[I].implicit = P_es->implicit;
  884.             D_env[I].done = FALSE;
  885.             D_env[I].node = D_env_lookup[P_es->name][I].node;
  886.             D_env[I].pid = D_env_lookup[P_es->name][I].pid;
  887.             D_env[I].parts = 0;
  888.             D_env[I].offset = 0;
  889.             D_env[I].size[0] = 0;
  890.            }
  891.  
  892.                         /* Call function that computes sizes, locations,
  893.                             and contiguities for each environment. */
  894.  
  895.         if (D_env->name == D_my_env.name)
  896.             this_env = D_my_env.index;
  897.         else
  898.             this_env = -1;
  899.         get_size(P_ssd, P_ddd, P_dmd, P_dnd, D_env,
  900.                                  this_env, TRUE, 0, FALSE, P_data->a, P_data->n);
  901.  
  902.             /* If there is nothing to be sent,
  903.                         issue an error message and exit the function. */
  904.  
  905.     if (D_env->total == 0)
  906.        {
  907. #if (D_MACH==D_SIM)
  908.         fprintf(stderr,
  909.             "ENV:%d,INDEX:%d;Implicit send called for data that has no copies.\n",
  910.                                             D_my_env.name,D_my_env.index);
  911. #endif
  912. #if (D_MACH==D_CUBE || D_MACH==D_GRAIL)
  913.         syslog(mypid(), "Implicit send called for data that has no copies.");
  914. #endif
  915. #if (D_MACH==D_CUBE2)
  916.         fprintf(stderr,
  917.             "ENV:%d,INDEX:%d;Implicit send called for data that has no copies.\n",
  918.                                             D_my_env.name,D_my_env.index);
  919. #endif
  920. #if (D_MACH==D_CUBE860)
  921.         fprintf(stderr,
  922.             "ENV:%d,INDEX:%d;Implicit send called for data that has no copies.\n",
  923.                                             D_my_env.name,D_my_env.index);
  924. #endif
  925.         return;
  926.        }
  927.                 /* For each environment, compute whether or not
  928.                         it needs a header and the number of parts
  929.                         it needs.  Determine if a temporary buffer
  930.                         is needed and what its size should be.
  931.                         Determine what the maximum number of
  932.                         message parts will be.*/
  933.  
  934.         for (I = 0; I < D_env->total; I++)
  935.             if (D_env[I].size[0] > 0)
  936.                {
  937.                 if (P_dnd->simple)
  938.                    {
  939.                     if (D_env[I].size[0] > D_MAX_MESS)
  940.                        {
  941.                         D_env[I].header = D_PM_HD_SZ + D_MP_HD_SZ +
  942.                                 2 * sizeof(long int) + D_LM_HD_SZ +
  943.                                 2 * sizeof(long int) + D_LME_DATA_HD_SZ;
  944.                         bufsize = D_MAX_MESS;
  945.                         D_env[I].parts = (D_env[I].size[0] + D_env[I].header) /
  946.                                         D_MAX_MESS + (((D_env[I].size[0] +
  947.                                         D_env[I].header) % D_MAX_MESS)?1:0);
  948.                         if (D_env[I].parts > D_part_num)
  949.                             D_part_num = D_env[I].parts;
  950.                        }
  951.                     else
  952.                        {
  953.                         D_env[I].header = 0;
  954.                         if (! D_env[I].contig[0])
  955.                            {
  956.                             if (bufsize < D_env[I].size[0])
  957.                                 bufsize = D_env[I].size[0];
  958.                            }
  959.                         D_env[I].parts = 1;
  960.                        }
  961.                    }
  962.                 else
  963.                    {
  964.                     D_env[I].header = D_PM_HD_SZ + D_MP_HD_SZ +
  965.                                 2 * sizeof(long int) + D_LM_HD_SZ +
  966.                                 2 * sizeof(long int) + D_LME_DATA_HD_SZ +
  967.                                 (1 + 2 * P_dnd->dims) * sizeof(long int);
  968.                     if (D_env[I].size[0] + D_env[I].header > D_MAX_MESS)
  969.                        {
  970.                         bufsize = D_MAX_MESS;
  971.                         D_env[I].parts = (D_env[I].size[0] + D_env[I].header) /
  972.                                         D_MAX_MESS + (((D_env[I].size[0] +
  973.                                         D_env[I].header) % D_MAX_MESS)?1:0);
  974.                         if (D_env[I].parts > D_part_num)
  975.                             D_part_num = D_env[I].parts;
  976.                        }
  977.                     else
  978.                        {
  979.                         if (bufsize < D_env[I].size[0] + D_env[I].header)
  980.                             bufsize = D_env[I].size[0] + D_env[I].header;
  981.                         D_env[I].parts = 1;
  982.                        }
  983.                    }
  984.                }
  985.  
  986.                         /* If there will be more than one part to
  987.                                 any message, get a message type
  988.                                 number for the subsequent parts. */
  989.  
  990.         if (D_part_num > 1)
  991.             D_sub_type = get_type();
  992.  
  993.  
  994.     } /* end initial analysis. */
  995.  
  996.             /***** MAIN LOOP *****/
  997.  
  998.             /***** For each part of a library created multi-part message: */
  999.  
  1000.     for (D_current_part = 0; D_current_part < D_part_num; D_current_part++)
  1001.         {
  1002.  
  1003.                 /***** For each environment involved in the message: */
  1004.  
  1005.         for (D_current_env = 0; D_current_env < D_env->total; D_current_env++)
  1006.            {
  1007.             if (D_env[D_current_env].clist[0]->dims == -1)
  1008.                {
  1009.                 if (! D_env[D_current_env].contig[0])
  1010.                    {
  1011.                     if (D_env[D_current_env].implicit)
  1012.                          map_select(P_ddd, P_dmd, D_my_env.index,
  1013.                                 D_env[D_current_env].index, TRUE, FALSE,
  1014.                                 P_data->a, D_env[D_current_env].clist[0]);
  1015.                     else
  1016.                          ddd_xform(P_ssd, P_ddd, D_env[D_current_env].clist[0]);
  1017.                    }
  1018.                }
  1019.  
  1020.                     /***** If this environment has this part: */
  1021.  
  1022.             if (D_env[D_current_env].parts > D_current_part)
  1023.                {
  1024.                 buf = bufptr = &(D_mess_buf[0]);
  1025.  
  1026.                         /***** Compute new message size if necessary. */
  1027.  
  1028.                 size = ((D_env[D_current_env].parts - 1) > D_current_part)?
  1029.                                 (D_MAX_MESS - (D_current_part == 0?
  1030.                                                 D_env[D_current_env].header:0)):
  1031.                                 (D_env[D_current_env].size[0] -
  1032.                                         D_env[D_current_env].offset);
  1033.  
  1034.                         /***** If we need a header: */
  1035.  
  1036.                 if ((D_env[D_current_env].header > 0) && (D_current_part == 0))
  1037.                     {
  1038.                             /* Physical message header. */
  1039.  
  1040.                     temp[0] = D_env[D_current_env].parts;
  1041.                     if (temp[0] > 1)
  1042.                         temp[1] = D_sub_type;
  1043.                     else
  1044.                         temp[1] = 0;
  1045.                     charp = (char *) temp;
  1046.                     for (I = 0; I < 2 * sizeof(long int); I++)
  1047.                         *(bufptr++) = *(charp++);
  1048.  
  1049.                             /* Message Package Header. */
  1050.  
  1051.                     temp[0] = 1;
  1052.                     temp[1] = D_my_env.name;
  1053.                     temp[2] = D_my_env.index;
  1054.                     temp[3] = 2 * sizeof(long int);
  1055.                     temp[4] = 3;
  1056.                     charp = (char *) temp;
  1057.                     for (I = 0; I < 5 * sizeof(long int); I++)
  1058.                         *(bufptr++) = *(charp++);
  1059.  
  1060.                             /* Logical message header. */
  1061.  
  1062.                     temp[0] = D_env[D_current_env].header -
  1063.                             (D_PM_HD_SZ + D_MP_HD_SZ + 2 * sizeof(long int)) +
  1064.                                                                         size;
  1065.                     temp[1] = 1;
  1066.                     temp[2] = 2 * sizeof(long int);
  1067.                     temp[3] = 3;
  1068.                     charp = (char *) temp;
  1069.                     for (I = 0; I < 4 * sizeof(long int); I++)
  1070.                         *(bufptr++) = *(charp++);
  1071.  
  1072.                             /* Logical message element header. */
  1073.  
  1074.                     temp[0] = 1;
  1075.                     if (P_dnd->simple)
  1076.                        {
  1077.                         temp[1] = 0;
  1078.                         temp_size = 3 * sizeof(long int);
  1079.                        }
  1080.                     else
  1081.                        {
  1082.                         temp[1] = (1 + D_env[D_current_env].desc->dims * 2) *
  1083.                                                             sizeof(long int);
  1084.                         temp[3] = D_env[D_current_env].desc->dims;
  1085.                         temp_size = 4 * sizeof(long int);
  1086.                        }
  1087.                     temp[2] = size;
  1088.                     charp = (char *) temp;
  1089.                     for (I = 0; I < temp_size; I++)
  1090.                         *(bufptr++) = *(charp++);
  1091.                     if (! P_dnd->simple)
  1092.                        {
  1093.                         charp = (char *) D_env[D_current_env].desc->range;
  1094.                         for (I = 0; I < D_env[D_current_env].desc->dims * 2 *
  1095.                                                         sizeof(long int); I++)
  1096.                             *(bufptr++) = *(charp++);
  1097.                        }
  1098.  
  1099.                     } /* end header setup. */
  1100.  
  1101.  
  1102.                         /***** If this pass involves new data: */
  1103.  
  1104.                 if ((! P_dmd->allflag) || (D_current_env == 0))
  1105.                    {
  1106.                     if (D_env[D_current_env].header ||
  1107.                                             (! D_env[D_current_env].contig[0]))
  1108.                        {
  1109.                         if (! D_env[D_current_env].contig[0])
  1110.                             (void) copy_data(P_ssd,
  1111.                             D_env[D_current_env].clist[0],
  1112.                                                 (long int) size, &bufptr, TRUE);
  1113.                         else
  1114.                            {
  1115.                             dataptr = D_env[D_current_env].loc[0] +
  1116.                                                 D_env[D_current_env].offset;
  1117.                             for (I = 0; I < size; I++)
  1118.                                 *(bufptr++) = *(dataptr++);
  1119.                            }
  1120.                        }
  1121.                     else
  1122.                         buf = D_env[D_current_env].loc[0] +
  1123.                                                 D_env[D_current_env].offset;
  1124.                    }
  1125.                 else
  1126.                     if (! D_env[D_current_env].header &&
  1127.                                                 D_env[D_current_env].contig[0])
  1128.                         buf = D_env[D_current_env].loc[0] +
  1129.                                                 D_env[D_current_env].offset;
  1130.  
  1131.                 D_env[D_current_env].offset += size;
  1132.  
  1133.  
  1134.                         /***** Send the message. */
  1135.  
  1136.                 working = TRUE;
  1137.                 if (P_es->implicit)
  1138.                    {
  1139.                     node = D_env[D_current_env].node;
  1140.                     pid = D_env[D_current_env].pid;
  1141.                    }
  1142.                 else
  1143.                    {
  1144.                     I = 0;
  1145.                     env_count = D_env_table[P_es->name].size;
  1146.                     for (J = 0; J < env_count; J++)
  1147.                         if (P_es->allflag || P_es->bitmap[J])
  1148.                             break;
  1149.                     node = D_env_lookup[P_es->name][J].node;
  1150.                     pid = D_env_lookup[P_es->name][J].pid;
  1151.                    }
  1152.  
  1153.                 do
  1154.                    {
  1155. #if D_HOST && (D_MACH==D_SIM || D_MACH==D_CUBE)
  1156.                     sendmsg(D_ci,
  1157.                             (D_current_part == 0?
  1158.                                 D_env[D_current_env].desc->type:D_sub_type),
  1159.                             buf, (int) (D_env[D_current_env].header &&
  1160.                                                             D_current_part == 0?
  1161.                                         size+D_env[D_current_env].header:size),
  1162.                             node, pid);
  1163. #else
  1164. #if (D_MACH==D_SIM || D_MACH==D_CUBE)
  1165.                     sendw(D_ci,
  1166.                             (D_current_part == 0?
  1167.                                 D_env[D_current_env].desc->type:D_sub_type),
  1168.                             buf, (int) (D_env[D_current_env].header &&
  1169.                                                             D_current_part == 0?
  1170.                                         size+D_env[D_current_env].header:size),
  1171.                             node, pid);
  1172. #else
  1173.                     csend((long)(D_current_part == 0?
  1174.                                 D_env[D_current_env].desc->type:D_sub_type),
  1175.                             buf, (long) (D_env[D_current_env].header &&
  1176.                                                             D_current_part == 0?
  1177.                                         size+D_env[D_current_env].header:size),
  1178.                            (long)node,(long)pid);
  1179. #endif
  1180. #endif
  1181.                     if (P_es->implicit)
  1182.                        {
  1183.                         working = FALSE;
  1184.                        }
  1185.                     else
  1186.                        {
  1187.                         J++;
  1188.                         if (! P_es[I].allflag)
  1189.                             for (; ! P_es[I].bitmap[J] && J < env_count; J++);
  1190.                         if (J == env_count)
  1191.                            {
  1192.                             I++;
  1193.                             if (I < P_es->count)
  1194.                                {
  1195.                                 env_count = D_env_table[P_es[I].name].size;
  1196.                                 for (J = 0; J < env_count; J++)
  1197.                                     if (P_es[I].allflag || P_es[I].bitmap[J])
  1198.                                         break;
  1199.                                 
  1200.                                }
  1201.                             else
  1202.                                {
  1203.                                 working = FALSE;
  1204.                                }
  1205.                            }
  1206.                         if (working)
  1207.                            {
  1208.                             node = D_env_lookup[P_es[I].name][J].node;
  1209.                             pid = D_env_lookup[P_es[I].name][J].pid;
  1210.                            }
  1211.                        }
  1212.                    }
  1213.                 while(working);
  1214.  
  1215.  
  1216. /* FUNKY DIAGNOSTICS 
  1217. pr_mess(buf); 
  1218.  END FUNKY DIAGNOSTICS */
  1219.  
  1220.                 } /* end part check. */
  1221.  
  1222.             } /* end environment loop. */
  1223.  
  1224.         } /* end part loop. */
  1225.  
  1226.  
  1227.                 /* Set or reset global variables as needed. */
  1228.  
  1229.     if (FALSE)
  1230.         {
  1231.         first = FALSE;
  1232.         }
  1233.     else
  1234.         {
  1235.         first = TRUE;
  1236.         }
  1237.   }
  1238.  
  1239.  
  1240. /********************************************************************
  1241.  *
  1242.  *  NAME:       D_isend_init --- Does the setup for an iterative send.
  1243.  *
  1244.  *  INPUTS:     A pointer to the buffer, the size of the buffer,
  1245.  *              an uninitialized storage space descriptor, a data
  1246.  *              distribution descriptor, an environment set, a data
  1247.  *              mapping descriptor, a data name descriptor, and pointers
  1248.  *              to data message types for the first and subsequent messages.  
  1249.  *
  1250.  *  OUTPUTS:    The header (if any) is placed in the buffer, the ssd
  1251.  *              is initialized for the free part of the buffer, and
  1252.  *              the message types are filled in.
  1253.  *
  1254.  *  NOTES:      See the formal interface description for more
  1255.  *              information.
  1256.  *
  1257.  ********************************************************************/
  1258.  
  1259. void D_isend_init(P_buf, P_size, P_elem_size, P_ssd, P_es,
  1260.                                         P_ddd, P_dmd, P_dnd, P_start, P_rest)
  1261.     char *P_buf;                    /* Pointer to new buffer */
  1262.     int P_size;                     /* Size of the new buffer */
  1263.     int P_elem_size;                /* Size of the basic data element */
  1264.     D_storage_space_desc *P_ssd;
  1265.     D_env_set *P_es;                /* Not used here */
  1266.     D_data_distribution_desc *P_ddd;/* Not used here */
  1267.     D_data_mapping_desc *P_dmd;     /* Not used here */
  1268.     D_data_name_desc *P_dnd;
  1269.     int *P_start;                   /* Type of initial message */
  1270.     int *P_rest;                    /* Type of all subsequent messages */
  1271.    {
  1272.     int I;
  1273.     long int size = 0;
  1274.     D_BOOL multiple = FALSE;
  1275.     char *charp;
  1276.     char *bufptr = P_buf;
  1277.     long int temp[5];
  1278.     int header;
  1279.     int temp_size;
  1280.  
  1281.     for (I = 0; I < P_dnd->dims; I++)
  1282.         size  *= (P_dnd->range[I].last - P_dnd->range[I].first + 1);
  1283.     size *= P_elem_size;
  1284.  
  1285.     *P_start = (*P_dnd->type)(P_dnd->range);
  1286.  
  1287.     header = D_PM_HD_SZ + D_MP_HD_SZ + 2 * sizeof(long int) + D_LM_HD_SZ +
  1288.                      2 * sizeof(long int) + D_LME_DATA_HD_SZ +
  1289.                     (P_dnd->simple?0:((1 + 2 * P_dnd->dims) * sizeof(long int)));
  1290.     if ((size + header) > D_MAX_MESS)
  1291.        {
  1292.         multiple = TRUE;
  1293.         *P_rest = get_type();
  1294.        }
  1295.  
  1296.     if (multiple || ! P_dnd->simple)
  1297.        {
  1298.                 /* Physical message header. */
  1299.  
  1300.         temp[0] = multiple?0:1;
  1301.         if (multiple)
  1302.             temp[1] = *P_rest;
  1303.         else
  1304.             temp[1] = 0;
  1305.         charp = (char *) temp;
  1306.         for (I = 0; I < 2 * sizeof(long int); I++)
  1307.             *(bufptr++) = *(charp++);
  1308.  
  1309.                 /* Message Package Header. */
  1310.  
  1311.         temp[0] = 1;
  1312.         temp[1] = D_my_env.name;
  1313.         temp[2] = D_my_env.index;
  1314.         temp[3] = 2 * sizeof(long int);
  1315.         temp[4] = 3;
  1316.         charp = (char *) temp;
  1317.         for (I = 0; I < 5 * sizeof(long int); I++)
  1318.             *(bufptr++) = *(charp++);
  1319.  
  1320.                 /* Logical message header. */
  1321.  
  1322.         temp[0] = header - (D_PM_HD_SZ + D_MP_HD_SZ + 2 * sizeof(long int)) +
  1323.                                                             size;
  1324.         temp[1] = 1;
  1325.         temp[2] = 2 * sizeof(long int);
  1326.         temp[3] = 3;
  1327.         charp = (char *) temp;
  1328.         for (I = 0; I < 4 * sizeof(long int); I++)
  1329.             *(bufptr++) = *(charp++);
  1330.  
  1331.                 /* Logical message element header. */
  1332.  
  1333.         temp[0] = 1;
  1334.         if (P_dnd->simple)
  1335.            {
  1336.             temp[1] = 0;
  1337.             temp_size = 3 * sizeof(long int);
  1338.            }
  1339.         else
  1340.            {
  1341.             temp[1] = (1 + P_dnd->dims * 2) * sizeof(long int);
  1342.             temp[3] = P_dnd->dims;
  1343.             temp_size = 4 * sizeof(long int);
  1344.            }
  1345.         temp[2] = size;
  1346.         charp = (char *) temp;
  1347.         for (I = 0; I < temp_size; I++)
  1348.             *(bufptr++) = *(charp++);
  1349.         if (! P_dnd->simple)
  1350.            {
  1351.             charp = (char *) P_dnd->range;
  1352.             for (I = 0; I < P_dnd->dims * 2 * sizeof(long int); I++)
  1353.                 *(bufptr++) = *(charp++);
  1354.            }
  1355.        } /* end header setup. */
  1356.     else
  1357.        {
  1358.         header = 0;
  1359.        }
  1360.     P_ssd->loc = bufptr;
  1361.     P_ssd->size = size - header;
  1362.    }
  1363.  
  1364.  
  1365.  
  1366. /********************************************************************
  1367.  *
  1368.  *  NAME:       D_lib_isend --- Does sends for multipart (iterative)
  1369.  *              explicit messages where compiler makes a call for
  1370.  *              each part.
  1371.  *
  1372.  *  INPUTS:     A pointer to the buffer, the message type of this
  1373.  *              message, a storage space descriptor, a data
  1374.  *              distribution descriptor, an environment set, a data
  1375.  *              mapping descriptor, and a data name descriptor.  
  1376.  *
  1377.  *  OUTPUTS:    The messager is sent and the storage space descriptor
  1378.  *              is updated for the currently empty buffer.
  1379.  *
  1380.  *  NOTES:      See the formal interface description for more
  1381.  *              information.
  1382.  *
  1383.  ********************************************************************/
  1384.  
  1385. void D_lib_isend(P_buf, P_type, P_ssd, P_es, P_ddd, P_dmd, P_dnd)
  1386.     char *P_buf;                      /* Pointer to new buffer */
  1387.     int P_type;                       /* type of this message */
  1388.     D_storage_space_desc *P_ssd;    /* Gives start and length of buffer
  1389.                                                                     on return */
  1390.     D_env_set *P_es;                /* Gives environment(s) message is going to */
  1391.     D_data_distribution_desc *P_ddd;/* Not used here */
  1392.     D_data_mapping_desc *P_dmd;     /* Not used here */
  1393.     D_data_name_desc *P_dnd;        /* Not used here */
  1394.    {
  1395.     int I, J;
  1396.     int node, pid;
  1397.  
  1398.     if (P_buf != P_ssd->loc)
  1399.        {
  1400.         P_ssd->size += P_ssd->loc - P_buf;
  1401.         P_ssd->loc = P_buf;
  1402.        }
  1403.  
  1404.     for (I = 0; I < P_es->count; I++)
  1405.         for (J = 0; J < D_env_table[P_es->name].size; J++)
  1406.             if (P_es[I].allflag || P_es[I].bitmap[J])
  1407.                {
  1408.                 node = D_env_lookup[P_es->name][J].node;
  1409.                 pid = D_env_lookup[P_es->name][J].pid;
  1410. #if D_HOST && (D_MACH==D_SIM || D_MACH==D_CUBE)
  1411.                 sendmsg(D_ci, P_type, P_ssd->loc, (int) P_ssd->size, node, pid);
  1412. #else
  1413. #if (D_MACH==D_SIM || D_MACH==D_CUBE)
  1414.                 sendw(D_ci, P_type, P_ssd->loc, (int) P_ssd->size, node, pid);
  1415. #else
  1416.                 csend((long)P_type, P_ssd->loc, (long) P_ssd->size,
  1417.                                                         (long)node, (long)pid);
  1418. #endif
  1419. #endif
  1420.                }
  1421.  
  1422.    }
  1423.  
  1424.  
  1425. /********************************************************************
  1426.  *
  1427.  *  NAME:       D_lib_irecv --- Does a receive of a multipart
  1428.  *              (iterative) explicit message where the compiler
  1429.  *              makes a call to this function for each part.
  1430.  *
  1431.  *  INPUTS:     A message type for this message ("0" for the first
  1432.  *              part, then whatever was returned by the call for the
  1433.  *              first part for the rest), storage space descriptor,
  1434.  *              a data distribution descriptor, an environment set,
  1435.  *              a data mapping descriptor, a data name descriptor,
  1436.  *              and an environment set.  
  1437.  *
  1438.  *  OUTPUTS:    The storage space descriptor is filled in for the
  1439.  *              current buffer, the type is filled in for future
  1440.  *              receives.
  1441.  *
  1442.  *  NOTES:      See the formal interface description for more
  1443.  *              information.
  1444.  *
  1445.  ********************************************************************/
  1446.  
  1447. void D_lib_irecv(P_type, P_elem_size, P_ssd, P_es,
  1448.                                             P_ddd, P_dmd, P_dnd, P_sync, P_data)
  1449.     int *P_type;                    /* Type of this message */
  1450.     int P_elem_size;                /* Size of basic data element. */
  1451.     D_storage_space_desc *P_ssd;    /* Set to buffer start and length on return */
  1452.     D_env_set *P_es;                /* Gives environment(s) message
  1453.                                                                 is coming from */
  1454.     D_data_distribution_desc *P_ddd;/* Not used here */
  1455.     D_data_mapping_desc *P_dmd;     /* Not used here */
  1456.     D_data_name_desc *P_dnd;
  1457.     D_BOOL P_sync;                  /* Not used here. */
  1458.     D_data_holder *P_data;          /* Need the env_array. */
  1459.    {
  1460.     int I;
  1461.     D_BOOL multiple = FALSE;
  1462.     int size;
  1463.     D_np *env;
  1464.     int cnt, node, pid;
  1465.     char *tmptr;
  1466.     long int *temp;
  1467.  
  1468.  
  1469.     if (*P_type == 0)
  1470.        {
  1471.         env =  P_data->e;
  1472.         env->total = 1;
  1473.         env->implicit = FALSE;
  1474.         env->done = FALSE;
  1475.         env->contig[0] = TRUE;
  1476.         env->loc[0] = &(D_mess_buf[0]);
  1477.         env->size[0] = 1;
  1478.  
  1479.         env->desc[0].type = (*P_dnd->type)(P_dnd->range);
  1480.         if (P_dnd->simple)
  1481.             env->desc[0].dims = 0;
  1482.         else
  1483.            {
  1484.             env->desc[0].dims = P_dnd->dims;
  1485.             for (I = 0; I < P_dnd->dims; I++)
  1486.                {
  1487.                 env->desc[0].range[I].first = P_dnd->range[I].first;
  1488.                 env->desc[0].range[I].last = P_dnd->range[I].last;
  1489.                }
  1490.            }
  1491.  
  1492.         for (I = 0; I < P_dnd->dims; I++)
  1493.             env->size[0]  *= (P_dnd->range[I].last - P_dnd->range[I].first + 1);
  1494.         env->size[0] *= P_elem_size;
  1495.  
  1496.         env->header = D_PM_HD_SZ + D_MP_HD_SZ + 2 * sizeof(long int) + D_LM_HD_SZ +
  1497.                      2 * sizeof(long int) + D_LME_DATA_HD_SZ +
  1498.                     (P_dnd->simple?0:((1 + 2 * P_dnd->dims) * sizeof(long int)));
  1499.         if (env->size[0] + (P_dnd->simple?0:env->header) > D_MAX_MESS)
  1500.             multiple = TRUE;
  1501.         if (! multiple && P_dnd->simple)
  1502.             env->header = 0;
  1503.  
  1504.         (void) get_message(env, TRUE, P_es, &size);
  1505.  
  1506.         if (multiple)
  1507.            {
  1508.             temp = (long int *) &(D_mess_buf[0]);
  1509.             *P_type = temp[1];
  1510.            }
  1511.  
  1512.         P_ssd->size = size - env->header;
  1513.         P_ssd->loc = &(D_mess_buf[0]) + env->header;
  1514.        }
  1515.     else
  1516.        {
  1517. #if D_HOST && (D_MACH==D_SIM || D_MACH==D_CUBE)
  1518.         tmptr = &(D_mess_buf[0]);
  1519.         D_recvh(D_ci, *P_type, &tmptr, D_MAX_MESS, &cnt, &node, &pid);
  1520. #else
  1521. #if (D_MACH==D_SIM || D_MACH==D_CUBE)
  1522.         recvw(D_ci, *P_type, &(D_mess_buf[0]), D_MAX_MESS, &cnt, &node, &pid);
  1523. #else 
  1524.         crecv((long)*P_type, &(D_mess_buf[0]),(long)D_MAX_MESS);
  1525. #endif
  1526. #endif
  1527.         P_ssd->size = cnt;
  1528. #if D_HOST && (D_MACH==D_SIM || D_MACH==D_CUBE)
  1529.         if (tmptr != &(D_mess_buf[0]))
  1530.            {
  1531.             D_mem_copy(&(D_mess_buf[0]), tmptr, P_ssd->size);
  1532.             B_free(tmptr);
  1533.            }
  1534. #endif
  1535.         P_ssd->loc = &(D_mess_buf[0]);
  1536.        }
  1537.    }
  1538.  
  1539. /***********************************************************/
  1540. /* This is the new stuff for handling composite procedures */
  1541. /***********************************************************/
  1542.  
  1543. int D_lib_cpc_a_init (cp_id, es)
  1544.     int cp_id;
  1545.     D_env_set *es;
  1546.  
  1547.     {
  1548.         D_le = -1;
  1549.         D_es = es;
  1550.         D_cp = cp_id;
  1551.         D_env_size = D_env_table [es->name].size;
  1552.         D_main_type = D_CPC_MTYPE;
  1553.         D_sub_type = 0;
  1554.         return (get_type());
  1555.     }
  1556.  
  1557. D_BOOL D_lib_cpc_a_next (return_type)
  1558.     int return_type;
  1559.  
  1560.     {
  1561.         /* Find the next environment to do */
  1562.         do {
  1563.             D_le++;
  1564.             if (D_es->allflag || D_es->implicit || D_es->bitmap[D_le])
  1565.                 break;
  1566.         } while (D_le < D_env_size);
  1567.  
  1568.         /* Exit if we're done */
  1569.         if (D_le == D_env_size)
  1570.             return (FALSE);
  1571.  
  1572.         /* Set up info on whom to send the message to */
  1573.         D_node = D_env_lookup [D_es->name][D_le].node;
  1574.         D_pid = D_env_lookup [D_es->name][D_le].pid;
  1575.  
  1576.         /* Set up the header for the message */
  1577.         D_mess_lint [0] = 12345;
  1578.         D_mess_lint [1] = D_my_env.name;
  1579.         D_mess_lint [2] = D_my_env.index;
  1580.         D_mess_lint [3] = D_cp;
  1581.         D_mess_lint [4] = return_type;
  1582.  
  1583.         /* Set up D_rem and D_buf */
  1584.         D_buf = (char *) (&D_mess_lint[5]);
  1585.         D_rem = D_MAX_MESS - 5 * sizeof (long int);
  1586.  
  1587.         /* Set up the message typeing stuff */
  1588.         D_first_msg = TRUE;
  1589.  
  1590.         /* That's it */
  1591.         return (TRUE);
  1592.     }
  1593.  
  1594. void D_lib_cpr_a_init (es)
  1595.     D_env_set *es;
  1596.  
  1597.     {
  1598.         int who;
  1599.  
  1600.         /* Get D_env_size set up right again ... it could be destroyed by
  1601.            an :: operator in the original Dino program */
  1602.         D_env_size = D_env_table [es->name].size;
  1603.  
  1604.         /* Count up the number of environments in this call */
  1605.         D_n_envs = 0;
  1606.         for (who = 0; who < D_env_size; who++)
  1607.             if (es->allflag || es->implicit || es->bitmap[who])
  1608.                 D_n_envs++;
  1609.  
  1610.         /* That's it! */
  1611.     }
  1612.  
  1613. D_BOOL D_lib_cpr_a_next (return_type)
  1614.     int return_type;
  1615.  
  1616.     {
  1617.         /* See if there's a next environment to do */
  1618.         if (D_n_envs-- == 0)
  1619.             return (FALSE);
  1620.  
  1621.         /* Read in the message */
  1622.         D_main_type = return_type;
  1623.         D_first_msg = TRUE;
  1624.         D_lib_refresh_buf();
  1625.  
  1626.         /* Get D_le out of the header */
  1627.         D_le = D_mess_lint [1];
  1628.  
  1629.         /* Skip over the header */
  1630.         D_buf = (char *) (&D_mess_lint[2]);
  1631.         D_rem = D_MAX_MESS - 2 * sizeof (long int);
  1632.  
  1633.         /* That's it! */
  1634.         return (TRUE);
  1635.     }
  1636.  
  1637. int D_lib_cpc_f_init ()
  1638.  
  1639.     {
  1640.         /* Pickup the future message type */
  1641.         D_sub_type = D_mess_lint [0];
  1642.  
  1643.         /* Set up D_buf and D_rem */
  1644.         D_buf = (char *) (&D_mess_lint[5]);
  1645.         D_rem = D_MAX_MESS - 5 * sizeof (long int);
  1646.  
  1647.         /* Set up caller */
  1648.         caller.name = D_mess_lint [1];
  1649.         caller.index = D_mess_lint [2];
  1650.  
  1651.         /* Set up D_first_msg */
  1652.         D_first_msg = FALSE;
  1653.  
  1654.         /* Get the return message type, and return it */
  1655.         return (D_mess_lint [4]);
  1656.     }
  1657.  
  1658. void D_lib_cpr_f_init (le, return_type)
  1659.     int return_type;
  1660.     int le;
  1661.  
  1662.     {
  1663.         /* Construct the new message header */
  1664.         D_mess_lint [1] = le;
  1665.         D_mess_lint [0] = 0;
  1666.  
  1667.         /* Setup D_buf and D_rem */
  1668.         D_buf = (char *) (&D_mess_lint[2]);
  1669.         D_rem = D_MAX_MESS - 2 * sizeof (long int);
  1670.  
  1671.         /* Setup D_first_msg */
  1672.         D_first_msg = TRUE;
  1673.  
  1674.         /* Use the caller variable to set up the return address */
  1675.         D_node = D_env_lookup[caller.name][caller.index].node;
  1676.         D_pid = D_env_lookup[caller.name][caller.index].pid;
  1677.  
  1678.         /* Set up D_main_type */
  1679.         D_main_type = return_type;
  1680.     }
  1681.  
  1682.  
  1683.  
  1684. long int D_block_func_l (le, limit, over, ediv, emod)
  1685.     int le, limit, over, ediv, emod;
  1686.  
  1687.     {
  1688.         long int t;
  1689.  
  1690.         t = le < emod ? le * (ediv + 1) : le * ediv + emod;
  1691.         return (D_max (limit, t - over));
  1692.     }
  1693.  
  1694. long int D_block_func_r (le, limit, over, ediv, emod)
  1695.     int le, limit, over, ediv, emod;
  1696.  
  1697.     {
  1698.         long int t;
  1699.  
  1700.         t = le < emod ? (le + 1) * (ediv + 1) : (le + 1) * ediv + emod;
  1701.         return (D_min (limit, t + over));
  1702.     }
  1703.  
  1704.  
  1705.  
  1706. void D_lib_flush_buf ()
  1707.  
  1708.     {
  1709.         int msg_type;
  1710.  
  1711.         /* Compute the next type */
  1712.         if (D_first_msg) {
  1713.             if (D_buf - D_mess_buf == D_MAX_MESS && D_sub_type == 0)
  1714.                 D_sub_type = get_type();
  1715.             D_mess_lint [0] = D_sub_type;
  1716.             msg_type = D_main_type;
  1717.             D_first_msg = FALSE;
  1718.         }
  1719.         else
  1720.             msg_type = D_sub_type;
  1721.  
  1722.         /* Send out the message */
  1723. #if D_HOST && (D_MACH==D_SIM || D_MACH==D_CUBE)
  1724.         sendmsg (D_ci, msg_type, D_mess_buf, (int)(D_buf - D_mess_buf),
  1725.             D_node, D_pid);
  1726. #else
  1727. #if (D_MACH==D_SIM || D_MACH==D_CUBE)
  1728.         sendw (D_ci, msg_type, D_mess_buf, (int)(D_buf - D_mess_buf),
  1729.             D_node, D_pid);
  1730. #else
  1731.         csend ((long)msg_type, D_mess_buf, (long)(D_buf - D_mess_buf),
  1732.             (long)D_node, (long)D_pid);
  1733. #endif
  1734. #endif
  1735.  
  1736.         /* Reset D_buf and D_rem */
  1737.         D_buf = D_mess_buf;
  1738.         D_rem = D_MAX_MESS;
  1739.     }
  1740.  
  1741. void D_lib_refresh_buf ()
  1742.  
  1743.     {
  1744.         int cnt, node, pid, msg_type;
  1745.  
  1746.         /* Compute the message type */
  1747.         msg_type = (D_first_msg ? D_main_type : D_sub_type);
  1748.  
  1749.         /* Read in the next message */
  1750. #if (D_MACH==D_SIM || D_MACH==D_CUBE)
  1751. #if D_HOST
  1752.         D_buf = D_mess_buf;
  1753.         D_recvh (D_ci, msg_type, &D_buf, D_MAX_MESS, &cnt, &node, &pid);
  1754.         if (D_buf != D_mess_buf)
  1755.             D_mem_copy (D_mess_buf, D_buf, cnt);
  1756. #else
  1757.         recvw (D_ci, msg_type, D_mess_buf, D_MAX_MESS, &cnt, &node, &pid);
  1758. #endif
  1759. #else
  1760.         crecv ((long)msg_type, D_mess_buf, (long)D_MAX_MESS);
  1761. #endif
  1762.  
  1763.         /* Reset D_buf and D_rem */
  1764.         D_buf = D_mess_buf;
  1765.         D_rem = D_MAX_MESS;
  1766.  
  1767.         /* Update D_sub_type, if necessary */
  1768.         if (D_first_msg) {
  1769.             D_sub_type = D_mess_lint [0];
  1770.             D_first_msg = FALSE;
  1771.         }
  1772.     }
  1773.  
  1774. void D_lib_align ()
  1775.  
  1776.     {
  1777.         int skip;
  1778.  
  1779.         /* Compute how much to skip */
  1780.         skip = D_rem % sizeof (double);
  1781.  
  1782.         /* Perform the skip */
  1783.         D_buf += skip;
  1784.         D_rem -= skip;
  1785.     }
  1786.  
  1787.  
  1788.  
  1789. /********************************************************************
  1790.  *
  1791.  *  NAME:       D_from --- Returns an envvar with the name and index
  1792.  *              of the last environment a message was received from.
  1793.  *
  1794.  *  INPUTS:       
  1795.  *
  1796.  *  OUTPUTS:    Returns an envvar with the name and index
  1797.  *              of the last environment a message was received from.
  1798.  *
  1799.  *  NOTES:      
  1800.  *
  1801.  ********************************************************************/
  1802.  
  1803. envvar D_from()
  1804.    {
  1805.     return D_snd_source;
  1806.    }
  1807.